home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / DDPLUS71.ZIP / DDOVR2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-01  |  8.0 KB  |  345 lines
  1.  
  2. unit ddovr2;
  3.  
  4. {$O+,F+,V-}
  5.  
  6. interface
  7.  
  8. uses dos,crt;
  9.  
  10. procedure Loadconfig(
  11.  fn: string;
  12.  var bbs_software: byte;
  13.  var user_first_name,user_last_name: string;
  14.  var user_access_level: word;
  15.  var bbs_time_left: integer;
  16.  var com_port: byte;
  17.  var baud_rate: longint;
  18.  var node_num: byte;
  19.  var local: boolean;
  20.  var graphics: byte;
  21.  var color1: boolean;
  22.  var color_chg: boolean;
  23.  var NoFossInit: boolean;
  24.  var board_name: string;
  25.  var pause_code: string;
  26.  var sysop_first_name: string;
  27.  var sysop_last_name: string;
  28.  var maxtime: word;
  29.  var localcol: boolean;
  30.  var statfore: byte;
  31.  var statback: byte;
  32.  var statline: boolean;
  33.  var EMSOk,NetOk,NoLocal: boolean;
  34.  var fossilio,digiio: boolean;
  35.  var dropfilepath: string;
  36.  var GoRip : byte;
  37.  var lockbaud: longint;
  38.  var nodirect: boolean;
  39.  var port1,port2,port3,port4:word;
  40.  var irq1,irq2,irq3,irq4 : byte);
  41.  
  42. var
  43.  ddcfgp1,ddcfgp2,ddcfgps: string[80];
  44. const
  45.  DDUserConfigPtr: pointer = nil;
  46.  
  47. implementation
  48.  
  49. type
  50.  iomodetypes=(localu,remote,maint);
  51. var
  52.  iomode: iomodetypes;
  53.  ctlnm:string[2];
  54. Procedure CallProc;
  55. inline($FF/$1E/DDUserConfigPtr);
  56.  
  57. procedure Loadconfig(
  58.  fn: string;
  59.  var bbs_software: byte;
  60.  var user_first_name,user_last_name: string;
  61.  var user_access_level: word;
  62.  var bbs_time_left: integer;
  63.  var com_port: byte;
  64.  var baud_rate: longint;
  65.  var node_num: byte;
  66.  var local: boolean;
  67.  var graphics: byte;
  68.  var color1: boolean;
  69.  var color_chg: boolean;
  70.  var noFossInit: boolean;
  71.  var board_name: string;
  72.  var pause_code: string;
  73.  var sysop_first_name: string;
  74.  var sysop_last_name: string;
  75.  var maxtime: word;
  76. { var quiet: boolean; }
  77.  var localcol: boolean;
  78.  var statfore: byte;
  79.  var statback: byte;
  80.  var statline: boolean;
  81.  var EMSOk,NetOK,NoLocal: boolean;
  82.  var fossilio,digiio: boolean;
  83.  var dropfilepath: string;
  84.  var GoRip : byte;
  85.  var lockbaud: longint;
  86.  var nodirect: boolean;
  87.  var port1,port2,port3,port4:word;
  88.  var irq1,irq2,irq3,irq4 : byte);
  89.  
  90. function getparam(s: string; n: integer): string;
  91. var
  92.  a: integer;
  93.  s2: string;
  94. begin;
  95.  while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  96.  if n<>1 then begin;
  97.   while (length(s)>0) and (s[1]<>' ') do delete(s,1,1);
  98.   while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  99.  end;
  100.  if n=3 then begin;
  101.   while (length(s)>0) and (s[1]<>' ') do delete(s,1,1);
  102.   while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  103.  end;
  104.  while (pos(' ',s)<>0) do begin;
  105.   a:=1;
  106.   s2:='';
  107.   while s[a]<>' ' do begin;
  108.    s2:=s2+upcase(s[a]);
  109.    a:=a+1;
  110.   end;
  111.   s:=s2;
  112.  end;
  113.  while (length(s)>0) and (s[length(s)]=' ') do delete(s,length(s),1);
  114.  for a:=1 to length(s) do s[a]:=upcase(s[a]);
  115.  getparam:=s;
  116. end;
  117.  
  118. function getsecond(s: string): string;
  119. var
  120.  a: integer;
  121.  s2: string;
  122. begin;
  123.  while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  124.  while (length(s)>0) and (s[1]<>' ') do delete(s,1,1);
  125.  while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
  126.  while (length(s)>0) and (s[length(s)]=' ') do delete(s,length(s),1);
  127.  getsecond:=s;
  128. end;
  129.  
  130. function numparams(s: string): integer;
  131. var
  132.  i: integer;
  133. begin;
  134.  i:=0;
  135.  numparams:=0;
  136.  if length(s)=0 then exit;
  137.  if s[1]=';' then exit;
  138.  if s[2]=';' then exit;
  139.  if getparam(s,1)<>'' then inc(i);
  140.  if getparam(s,2)<>'' then inc(i);
  141.  if getparam(s,3)<>'' then inc(i);
  142.  numparams:=i;
  143. end;
  144.  
  145. procedure Port_rtn (var s2,s3 : string;
  146.                     var portadd : word;
  147.                     var irq  : byte);
  148. var
  149.   a : integer;
  150. begin
  151.   val('$'+s2,portadd,a);
  152.   val(s3,irq,a);
  153. end;
  154.  
  155. procedure DDError(s: string);
  156. begin;
  157.  write(^G^G);
  158.  writeln('ERROR: '+s);
  159.  write(^G^G);
  160.  delay(2000);
  161. end;
  162.  
  163. procedure BadParam(s: string);
  164. begin;
  165.  dderror('Invalid parameter');
  166.  halt;
  167. end;
  168.  
  169. procedure processcmdline;
  170. var
  171.  a,b: integer;
  172.  s,s2: string;
  173. begin;
  174.  iomode:=remote;
  175.  dropfilepath:='';
  176.  ctlnm:='';
  177.  for a:=1 to paramcount do begin;
  178.   s:=paramstr(a);
  179.   for b:=1 to length(s) do s[b]:=upcase(s[b]);
  180.   if (s[1]='/') and (length(s)>1) then begin;
  181.    delete(s,1,1);
  182.    s2:=s;
  183.    delete(s2,1,1);
  184.    EMSOK:=False;
  185.    case s[1] of
  186.     'B': val(s2,lockbaud,b);
  187.     'C': val(s2,com_port,b);
  188.     'E': EMSOk:=true;
  189.     'H','F' : iomode:=maint;
  190.     'L': iomode:=localu;
  191.     'N': val(s2,node_num,b);
  192.     'M': ctlnm := s2;
  193.     'P': begin;
  194.           if s2[length(s2)]<>'\' then s2:=s2+'\';
  195.           dropfilepath:=s2;
  196.          end;
  197.     'R': GoRip:=4;
  198.     'V': NoLocal:=true;
  199.     'W': NetOk:=true;
  200.    end;
  201.   end;
  202.  end;
  203. end;
  204.  
  205. Procedure SelectCtl;
  206. var
  207.   P : PathStr;
  208.   D : DirStr;
  209.   N : NameStr;
  210.   E : ExtStr;
  211. begin
  212.   p := fn;
  213.   Fsplit(p,d,n,e);
  214.   fn := d+n+ctlnm+e;
  215. end;
  216.  
  217. var
  218.  s: string;
  219.  f: text;
  220.  a,b,c: integer;
  221.  ps,p1,p2,p3: string[80];
  222.  ofm: word;
  223. begin;
  224.  maxtime:=999;
  225.  localcol:=true;
  226.  sysop_first_name:='STEVE';
  227.  sysop_last_name:='LORENZ';
  228.  board_name:='The Officers Club BBS';
  229.  pause_code:='@PAUSE@';
  230.  bbs_software:=1;
  231.  statline:=true;
  232.  nodirect:=false;
  233.  color1:=false;
  234.  EMSOK:=false;
  235.  NetOK:=false;
  236.  NoLocal:=false;
  237.  fossilio:=false;
  238.  digiio:=false;
  239.  lockbaud:=0;
  240.  processcmdline;
  241.  selectctl;
  242.  ofm:=filemode;
  243.  filemode:=66;
  244.  assign(f,fn);
  245.  {$i-}
  246.  reset(f);
  247.  {$I+}
  248.  if ioresult<>0 then
  249.    begin
  250.      assign(f,'ddplus.ctl');
  251.      {$i-}
  252.      reset(f);
  253.      {$I+}
  254.    end;
  255.  if ioresult<>0 then dderror('Configuration file, '+fn+', is missing!');
  256.  while not eof(f) do begin;
  257.   readln(f,s);
  258.   if numparams(s)>0 then begin;
  259.    p1:=getparam(s,1);
  260.    p2:=getparam(s,2);
  261.    p3:=getparam(s,3);
  262.    ps:=getsecond(s);
  263.  
  264.   if p1='SYSOPFIRST' then sysop_first_name:=ps else
  265.    if p1='SYSOPLAST' then sysop_last_name:=ps else
  266.    if p1='BBSNAME' then board_name:=ps else
  267.    if p1='BBSTYPE' then begin;
  268.     if p2='LOCAL' then bbs_software:=1;
  269.     if p2='QUICK' then bbs_software:=3 else
  270.     if p2='PCB12' then bbs_software:=4 else
  271.     if p2='WWIV' then bbs_software:=5 else
  272.     if p2='PCB15' then bbs_software:=6 else
  273.     if p2='RBBS' then bbs_software:=7 else
  274.     if p2='PHOENIX' then bbs_software:=8 else
  275.     if p2='DORINFO1' then bbs_software:=9 else
  276.     if p2='PCB14' then bbs_software:=10 else
  277.     if p2='DOORSYS' then bbs_software:=11 else
  278.     if p2='SPITFIRE' then bbs_software:=12 else
  279.     if p2='2AM' then bbs_software:=13 else
  280.     if p2='TRIBBS' then bbs_software:=14 else
  281.      badparam(s);
  282.    end else
  283.    if p1='STATUS' then begin;
  284.     if p2='OFF' then statline:=false else
  285.     if p2='ON' then statline:=true else
  286.      badparam(s);
  287.    end else
  288.    if p1='DIGI'   then digiio:=true   else
  289.    if p1='FOSSIL' then fossilio:=true else
  290.    if p1='XFOSSIL' then
  291.        begin
  292.          fossilio:=true;
  293.          noFossInit:=true;
  294.        end                                 else
  295.    if p1='LOCKBAUD' then val(p2,lockbaud,a) else
  296.    if p1='PORT1'    then port_rtn(p2,p3,port1,irq1) else
  297.    if p1='PORT2'    then port_rtn(p2,p3,port2,irq2) else
  298.    if p1='PORT3'    then port_rtn(p2,p3,port3,irq3) else
  299.    if p1='PORT4'    then port_rtn(p2,p3,port4,irq4) else
  300.    if p1='STATFORE' then val(p2,statfore,a) else
  301.    if p1='STATBACK' then val(p2,statback,a) else
  302.    if p1='MAXTIME' then val(p2,maxtime,a) else
  303.    if p1='COLOR' then localcol:=true else
  304.    if p1='MONO' then localcol:=false else
  305.    if p1='COLOR1' then color1:=true else
  306.    if p1='COMPORT' then val(p2,com_port,a) else
  307.    if p1='PAUSECODE' then pause_code:=ps else
  308.  
  309.    begin;
  310.     ddcfgp1:=p1;
  311.     ddcfgp2:=p2;
  312.     ddcfgps:=ps;
  313.     if dduserconfigptr<>nil then callproc;
  314.    end;
  315.  
  316.   end;
  317.  end;
  318.  close(f);
  319.  filemode:=ofm;
  320.  
  321.  case iomode of
  322.   remote: ;
  323.   maint : bbs_software:=0;
  324.   localu: bbs_software:=1;
  325.  end;
  326. end;
  327.  
  328. end.
  329.  
  330. {
  331.  /E - Use EMS for extra memory for overlays
  332.  /Bxxx - Specify locked baud rate (i.e. /B38400)
  333.  /C    - Specify comport number.
  334.  /H    - Specify maintenance mode 1.
  335.  /F    - Specify maintenance mode 2.
  336.  /L -    Local mode';
  337.  /Nx   - Specify node number
  338.  /Mx   - Specify multiple ctl file number
  339.  /R    - Force RIP graphics
  340.  /Pyyy - Specify path to drop file (i.e. /Pc:\bbs)
  341.  /V    - Turn local vidio off (i.e. local blue screen
  342.  /W - A Dos only Network is present
  343.  
  344.     }
  345.